home *** CD-ROM | disk | FTP | other *** search
/ Fritz: All Fritz / All Fritz.zip / All Fritz / FILES / PROGBLER / WHIZZARD.LZH / SUBDEMO.BAS < prev    next >
BASIC Source File  |  1984-06-26  |  22KB  |  518 lines
  1. 10 REM
  2. 20 REM    Determine whether we are running compiled or interpreted
  3. 30 REM            FLAG% = 0    if interpreted
  4. 40 REM            FLAG% = 1    if compiled without /O (needs BASRUN.EXE)
  5. 45 REM            FLAG% = 2    if compiled with /O
  6. 50 REM            FLAG% = 3    if business basic compiled
  7. 60 REM
  8. 65 DEFINT I      '   *****  this ISUBINIT will be an integer
  9. 70    KEY OFF
  10. 80    FOR I% = 1 TO 10
  11. 90       KEY I%,""
  12. 100    NEXT I%
  13. 110 REM
  14. 120   DEF SEG
  15. 130   TEST$ = "K"
  16. 140   A% = VARPTR(TEST$)
  17. 150    B% = PEEK(A%+1) + 256*PEEK(A%+2)
  18. 160     IF CHR$(PEEK(B%)) = "K" THEN FLAG% = 0 : GOTO 230
  19. 170    B% = PEEK(A%+2) + 256*PEEK(A%+3)
  20. 180     IF CHR$(PEEK(B%)) <> "K" THEN FLAG% = 3 : GOTO 740
  21. 182      WIDTH 80 : IF PEEK(&H7CC) = 80 THEN FLAG% = 1   ELSE FLAG% = 2
  22. 188       GOTO 740
  23. 200 REM
  24. 210 REM If interpreted, check that ASMBASIC is resident below the interpreter
  25. 220 REM
  26. 230  DEF SEG = 0
  27. 240  A% = PEEK(&H19C) + 256*PEEK(&H19D) : B% = PEEK(&H19E) + 256*PEEK(&H19F)
  28. 250    DEF SEG = B%
  29. 260    IF (PEEK(A%-1) = &H52) AND (PEEK(A%-2) = &H52) THEN 330
  30. 270      CLS : PRINT TAB(85);"ASMBASIC must be executed once before starting"
  31. 280        PRINT TAB(15);"the Basic interpreter"
  32. 290      SYSTEM
  33. 300 REM
  34. 310 REM If interpreted, then get the segment and offset of the utility routines
  35. 320 REM
  36. 330    DEF SEG
  37. 340    DIM INIT%(3)           ' setup subroutine containing  INT  67h
  38. 350    INIT%(1) = &H67CD       '                              RETF 2
  39. 360    INIT%(2) = &H2CA
  40. 370    INIT%(3) = 0
  41. 380    ISUBINIT = 0
  42. 390 REM
  43. 400 REM         get the code segment of the utility subroutines
  44. 410  SEGVALUE% = 0
  45. 420    ISUBINIT = VARPTR(INIT%(1)): CALL ISUBINIT(SEGVALUE%)
  46. 430 REM
  47. 440 REM         get the offset of the utility subroutines
  48. 450  A% = 1
  49. 460    ISUBINIT = VARPTR(INIT%(1)):CALL ISUBINIT(A%)
  50. 470     QPRINT = A%
  51. 480  A% = 2
  52. 490    ISUBINIT = VARPTR(INIT%(1)):CALL ISUBINIT(A%)
  53. 500     SCRLDN = A%
  54. 510  A% = 3
  55. 520    ISUBINIT = VARPTR(INIT%(1)):CALL ISUBINIT(A%)
  56. 530     SCRLUP = A%
  57. 540  A% = 4
  58. 550    ISUBINIT = VARPTR(INIT%(1)):CALL ISUBINIT(A%)
  59. 560     XREP = A%
  60. 570  A% = 5
  61. 580    ISUBINIT = VARPTR(INIT%(1)):CALL ISUBINIT(A%)
  62. 590     YREP = A%
  63. 600  A% = 6
  64. 610    ISUBINIT = VARPTR(INIT%(1)):CALL ISUBINIT(A%)
  65. 620     CLREOL = A%
  66. 630  A% = 7
  67. 640    ISUBINIT = VARPTR(INIT%(1)):CALL ISUBINIT(A%)
  68. 650     CLREOS = A%
  69. 660  A% = 8
  70. 670    ISUBINIT = VARPTR(INIT%(1)):CALL ISUBINIT(A%)
  71. 680     ZPRINT = A%
  72. 690 REM
  73. 700 REM         set the segment value for interpreted basic
  74. 710 REM
  75. 720     DEF SEG = SEGVALUE%
  76. 730 REM
  77. 740 REM  define some attributes for use throughout the demo
  78. 750 REM
  79. 760    CLS : LOCATE 4,4 : INPUT "Would you like the demonstration in color (Y/N)";A$
  80. 770    IF A$ = "Y" OR A$ = "y" THEN 970
  81. 780    IF A$ <> "N" AND A$ <> "n" THEN 760
  82. 790 REM
  83. 800 REM     black and white attributes
  84. 810 REM
  85. 820    NORMAL%  = 7   ' normal intensity white on black
  86. 830    BLUE%     = 7
  87. 840    GREEN%     = 7
  88. 850    CYAN%     = 7
  89. 860    RED%     = 7
  90. 870    MAGENTA% = 7
  91. 880    BROWN%     = 7
  92. 890    YELLOW%  = 7
  93. 900    WHITE%     = 15  ' high intensity white on black
  94. 910    LIGHTER% = 7
  95. 920    BLINK%     = 128
  96. 930        GOTO 1240
  97. 940 REM
  98. 950 REM     color attributes
  99. 960 REM
  100. 970    NORMAL%  = 7   ' normal intensity white on black
  101. 980    BLUE%     = 1
  102. 990    GREEN%     = 2
  103. 1000    CYAN%     = 3
  104. 1010    RED%     = 4
  105. 1020    MAGENTA% = 5
  106. 1030    BROWN%     = 6
  107. 1040    YELLOW%  = 14
  108. 1050    WHITE%     = 15  ' high intensity white on black
  109. 1060 REM
  110. 1070 REM  To make a color lighter, logically OR the LIGHTER% with
  111. 1080 REM    the color.
  112. 1090 REM         Ex:      ATTRIBUTE% = RED% OR LIGHTER%
  113. 1100 REM    will give a light red color.
  114. 1110 REM
  115. 1120           LIGHTER% = 8
  116. 1130 REM
  117. 1140 REM  To make a color blink, logically OR the BLINK% with
  118. 1150 REM    the color.
  119. 1160 REM         Ex:      ATTRIBUTE% = RED% OR BLINK%
  120. 1170 REM    will give a blinking red color.
  121. 1180 REM
  122. 1190           BLINK% = 128
  123. 1200 REM
  124. 1210 REM
  125. 1220 REM  start by demonstrating XREP --------------------------------------
  126. 1230 REM
  127. 1240    CLS : INPUT "Type a carriage return for a countdown by subroutine XREP",A$
  128. 1250     FOR I% = 9 TO 0 STEP -1
  129. 1260           LOCATE 1,1
  130. 1270           COUNT% = 2000        ' write 2000 characters (full screen
  131. 1280           LETTER$ = RIGHT$(STR$(I%),1)   ' letter to write is loop counter
  132. 1290 REM      if user asks for a color display then use I% to set color
  133. 1300          IF BLUE% = 1 THEN ATTRIBUTE% = I% + 1 ELSE ATTRIBUTE% = NORMAL%
  134. 1310           CALL XREP( FLAG% , LETTER$ , COUNT% , ATTRIBUTE% )
  135. 1320     NEXT I%
  136. 1330 REM
  137. 1340    CLS : LOCATE 2,1
  138. 1350    PRINT TAB(3);"XREP repeats a given character along the x axis"
  139. 1360    PRINT TAB(9);"The argument list for XREP includes the repetition count"
  140. 1370    PRINT TAB(9);"and color you want for the character.  The demonstration"
  141. 1380    PRINT TAB(9);"countdown is generated by a LOCATE 1,1 followed by a call"
  142. 1390    PRINT TAB(9);"to XREP with a repeat count of 2000 (25 lines times 80"
  143. 1400    PRINT TAB(9);"columns = 2000)."
  144. 1410      LOCATE 10,20 : A$ = "A" : COUNT% = 40
  145. 1420           CALL XREP( FLAG% , A$ , COUNT% , NORMAL% )
  146. 1430      LOCATE 11,25 : A$ = "B" : COUNT% = 30
  147. 1440           CALL XREP( FLAG% , A$ , COUNT% , NORMAL% )
  148. 1450      LOCATE 12,30 : A$ = "C" : COUNT% = 20
  149. 1460           CALL XREP( FLAG% , A$ , COUNT% , NORMAL% )
  150. 1470      LOCATE 13,35 : A$ = "D" : COUNT% = 10
  151. 1480           CALL XREP( FLAG% , A$ , COUNT% , NORMAL% )
  152. 1490      LOCATE 14,39 : A$ = "E" : COUNT% = 2
  153. 1500           CALL XREP( FLAG% , A$ , COUNT% , NORMAL% )
  154. 1510      LOCATE 15,35 : A$ = "F" : COUNT% = 10
  155. 1520           CALL XREP( FLAG% , A$ , COUNT% , NORMAL% )
  156. 1530      LOCATE 16,30 : A$ = "G" : COUNT% = 20
  157. 1540           CALL XREP( FLAG% , A$ , COUNT% , NORMAL% )
  158. 1550      LOCATE 17,25 : A$ = "H" : COUNT% = 30
  159. 1560           CALL XREP( FLAG% , A$ , COUNT% , NORMAL% )
  160. 1570      LOCATE 18,20 : A$ = "I" : COUNT% = 40
  161. 1580           CALL XREP( FLAG% , A$ , COUNT% , NORMAL% )
  162. 1590 REM
  163. 1600    LOCATE 20,5
  164. 1610    PRINT TAB(3);"Press ESC to repeat the XREP countdown.  Enter a carriage"
  165. 1620    PRINT TAB(3);"return to proceed to the next demonstration."
  166. 1630    X$ = INKEY$ : IF LEN(X$) = 0 THEN 1630
  167. 1640    IF X$ = CHR$(13) THEN 1700
  168. 1650    IF X$ = CHR$(27) THEN 1250 ELSE 1630
  169. 1660 REM
  170. 1670 REM
  171. 1680 REM  next demonstrate    YREP --------------------------------------
  172. 1690 REM
  173. 1700    CLS : LOCATE 2,2
  174. 1710    PRINT "Just as XREP repeats a character along the X axis"
  175. 1720    PRINT "YREP repeats a character down the Y axis.  For applications"
  176. 1730    PRINT "with vertical elements, this beats the tar out of a series"
  177. 1740    PRINT "of LOCATE:PRINT statment pairs."
  178. 1750    PRINT
  179. 1760    INPUT "Type a carriage return for a demonstration of subroutine YREP",A$
  180. 1770 REM
  181. 1780    CLS
  182. 1790    LOCATE 1,1 : LETTER$ = "A" : COUNT% = 25 : ATTRIBUTE% = NORMAL%
  183. 1800             GOSUB 2310
  184. 1810    LOCATE 2,2 : LETTER$ = "B" : COUNT% = 23 : ATTRIBUTE% = BLUE%
  185. 1820             GOSUB 2310
  186. 1830    LOCATE 3,3 : LETTER$ = "C" : COUNT% = 21 : ATTRIBUTE% = GREEN%
  187. 1840             GOSUB 2310
  188. 1850    LOCATE 4,4 : LETTER$ = "D" : COUNT% = 19 : ATTRIBUTE% = CYAN%
  189. 1860             GOSUB 2310
  190. 1870    LOCATE 5,5 : LETTER$ = "E" : COUNT% = 17 : ATTRIBUTE% = RED%
  191. 1880             GOSUB 2310
  192. 1890   LOCATE 6,6 : LETTER$ = "F" : COUNT% = 15 : ATTRIBUTE% = MAGENTA%
  193. 1900             GOSUB 2310
  194. 1910   LOCATE 7,7 : LETTER$ = "G" : COUNT% = 13 : ATTRIBUTE% = BROWN%
  195. 1920             GOSUB 2310
  196. 1930   LOCATE 8,8 : LETTER$ = "H" : COUNT% = 11
  197. 1940             ATTRIBUTE% = BLUE% OR LIGHTER%
  198. 1950             GOSUB 2310
  199. 1960   LOCATE 9,9 : LETTER$ = "I" : COUNT% = 9
  200. 1970             ATTRIBUTE% = GREEN% OR LIGHTER%
  201. 1980             GOSUB 2310
  202. 1990   LOCATE 10,10 : LETTER$ = "J" : COUNT% = 7
  203. 2000              ATTRIBUTE% = CYAN% OR LIGHTER%
  204. 2010              GOSUB 2310
  205. 2020   LOCATE 11,11 : LETTER$ = "K" : COUNT% = 5
  206. 2030              ATTRIBUTE% = RED% OR LIGHTER%
  207. 2040              GOSUB 2310
  208. 2050   LOCATE 12,12 : LETTER$ = "L" : COUNT% = 3
  209. 2060              ATTRIBUTE% = MAGENTA% OR LIGHTER%
  210. 2070              GOSUB 2310
  211. 2080   LOCATE 13,13 : LETTER$ = "M" : COUNT% = 1
  212. 2090              ATTRIBUTE% = BROWN% OR LIGHTER%
  213. 2100              GOSUB 2310
  214. 2110   LOCATE 14,14 : LETTER$ = "N" : COUNT% = 24
  215. 2120              ATTRIBUTE% = BLUE% OR BLINK%
  216. 2130              GOSUB 2310
  217. 2140   LOCATE 15,15 : LETTER$ = "O" : COUNT% = 22
  218. 2150              ATTRIBUTE% = GREEN%
  219. 2160              GOSUB 2310
  220. 2170   LOCATE 16,16 : LETTER$ = "P" : COUNT% = 20
  221. 2180              ATTRIBUTE% = CYAN%
  222. 2190              GOSUB 2310
  223. 2200   LOCATE 17,17 : LETTER$ = "Q" : COUNT% = 18
  224. 2210              ATTRIBUTE% = RED%
  225. 2220              GOSUB 2310
  226. 2230   LOCATE 18,18 : LETTER$ = "R" : COUNT% = 16
  227. 2240              ATTRIBUTE% = MAGENTA%
  228. 2250              GOSUB 2310
  229. 2260   LOCATE 19,19 : LETTER$ = "S" : COUNT% = 14
  230. 2270              ATTRIBUTE% = BROWN%
  231. 2280              GOSUB 2310
  232. 2290   GOTO 2330
  233. 2300 REM
  234. 2310     CALL YREP( FLAG% , LETTER$ , COUNT% , ATTRIBUTE% ) : RETURN
  235. 2320 REM
  236. 2330   LOCATE 2,30 : PRINT "Like XREP, the argument list for YREP includes the"
  237. 2340   LOCATE 3,30 : PRINT "repeat count and the color of the character."
  238. 2350   LOCATE 4,30 : PRINT "When a repeat count carries a character off the"
  239. 2360   LOCATE 5,30 : PRINT "bottom of the screen it wraps around to the top."
  240. 2370 REM
  241. 2380   LOCATE 7,30 : PRINT "Press ESC to repeat the YREP screen."
  242. 2390   LOCATE 8,30 : PRINT "  Enter a carriage return to proceed to"
  243. 2400   LOCATE 9,30 : PRINT "  the next demonstration."
  244. 2410   X$ = INKEY$ : IF LEN(X$) = 0 THEN 2410
  245. 2420   IF X$ = CHR$(13) THEN 2450
  246. 2430   IF X$ = CHR$(27) THEN 1780 ELSE 2410
  247. 2440 REM
  248. 2450 REM
  249. 2460 REM  next demonstrate     QPRINT --------------------------------------
  250. 2470 REM
  251. 2480   CLS : LOCATE 2,1
  252. 2490   PRINT TAB(3);"QPRINT will quickly print any string on the screen"
  253. 2500   PRINT TAB(9);"starting at the current location.  The cursor is then"
  254. 2510   PRINT TAB(9);"moved to just after the string.  Whatever color has been"
  255. 2520   PRINT TAB(9);"set by the BASIC COLOR statement will be used by QPRINT"
  256. 2530   PRINT TAB(9);"to print the string passed to it."
  257. 2540    PRINT
  258. 2550    INPUT "Type a carriage return to display a screen using subroutine QPRINT",A$
  259. 2560 REM
  260. 2562   CLS : LOCATE 2,20
  261. 2564    A$ = "This screen has been printed using QPRINT"
  262. 2566    CALL QPRINT( FLAG% , A$ )
  263. 2570   LOCATE 5,5
  264. 2580    A$ = "There are eight subroutines in the Basic Support Clubware Package"
  265. 2590    CALL QPRINT( FLAG% , A$ )
  266. 2600   LOCATE 7,10
  267. 2610    A$ = "XREP     - repeat a character along the X axis some number of times"
  268. 2620    CALL QPRINT( FLAG% , A$ )
  269. 2630   LOCATE 9,10
  270. 2640    A$ = "YREP     - repeat a character down the y axis some number of times"
  271. 2650    CALL QPRINT( FLAG% , A$ )
  272. 2660   LOCATE 11,10
  273. 2670    A$ = "QPRINT   - quickly print a string on the screen"
  274. 2680    CALL QPRINT( FLAG% , A$ )
  275. 2690   LOCATE 13,10
  276. 2700    A$ = "ZPRINT   - write a string to the screen using a special color attribute"
  277. 2710    CALL QPRINT( FLAG% , A$ )
  278. 2720   LOCATE 15,10
  279. 2730    A$ = "SCRLDN   - scroll some portion of the screen down"
  280. 2740    CALL QPRINT( FLAG% , A$ )
  281. 2750   LOCATE 17,10
  282. 2760    A$ = "SCRLUP   - scroll some portion of the screen up"
  283. 2770    CALL QPRINT( FLAG% , A$ )
  284. 2780   LOCATE 19,10
  285. 2790    A$ = "CLREOS   - clear screen from current position to end of page"
  286. 2800    CALL QPRINT( FLAG% , A$ )
  287. 2810   LOCATE 21,10
  288. 2820    A$ = "CLREOL   - clear screen from current position to end of line"
  289. 2830    CALL QPRINT( FLAG% , A$ )
  290. 2840 REM
  291. 2850   LOCATE 24,5
  292. 2860    A$ = "Press ESC to rewrite the screen using QPRINT.  Enter a carriage"
  293. 2870    CALL QPRINT( FLAG% , A$ )
  294. 2880   LOCATE 25,5
  295. 2890    A$ = "return to proceed to the next demonstration."
  296. 2900    CALL QPRINT( FLAG% , A$ )
  297. 2910    X$ = INKEY$ : IF LEN(X$) = 0 THEN 2910
  298. 2920    IF X$ = CHR$(13) THEN 2940
  299. 2930    IF X$ = CHR$(27) THEN 2570 ELSE 2910
  300. 2940 REM
  301. 2950 REM
  302. 2960 REM  next demonstrate     CLREOL and CLREOS ---------------------------
  303. 2970 REM
  304. 2980   CLS : LOCATE 2,1
  305. 2990   PRINT TAB(3);"CLREOL will clear from the current position to the"
  306. 3000   PRINT TAB(9);"end of the line and CLREOS will clear from the current"
  307. 3010   PRINT TAB(9);"position to the end of the screen.  Move the cursor using"
  308. 3020   PRINT TAB(9);"the cursor control keys (up ";CHR$(24);", down ";CHR$(25);
  309. 3030          PRINT ", left ";CHR$(27);", right ";CHR$(26);") then"
  310. 3040   PRINT TAB(12);"press F1 to demonstrate CLREOL"
  311. 3050   PRINT TAB(12);"press F2 to demonstrate CLREOS"
  312. 3060 REM
  313. 3070   A$ = "ABCDEFGHIJ----------KLMNOPQRST----------"
  314. 3080   B$ = "----------1234567890----------1234567890"
  315. 3090    LOCATE 9,1
  316. 3100 REM
  317. 3110 REM       Use qprint to prevent unwanted scrolls when writing line 24, 25
  318. 3120 REM
  319. 3130     FOR I% = 1 TO 8
  320. 3140        PRINT A$; :  CALL QPRINT( FLAG% , B$ )
  321. 3150        PRINT B$; :  CALL QPRINT( FLAG% , A$ )
  322. 3160     NEXT I%
  323. 3170        PRINT A$; :  CALL QPRINT( FLAG% , B$ )
  324. 3180 REM
  325. 3190    Y% = 15 : X% = 40
  326. 3200    LOCATE Y%,X%,1
  327. 3210    X$ = INKEY$ : IF LEN(X$) < 2 THEN 3210
  328. 3220    X$ = RIGHT$(X$,1)
  329. 3230    IF X$ = CHR$(59) THEN CALL CLREOL( FLAG% ) : GOTO 3370    'F1
  330. 3240    IF X$ = CHR$(60) THEN CALL CLREOS( FLAG% ) : GOTO 3370    'F2
  331. 3250    IF X$ = CHR$(72) THEN Y% = Y% - 1       : GOTO 3320    'up
  332. 3260    IF X$ = CHR$(80) THEN Y% = Y% + 1       : GOTO 3320    'down
  333. 3270    IF X$ = CHR$(75) THEN X% = X% - 1       : GOTO 3300    'left
  334. 3280    IF X$ = CHR$(77) THEN X% = X% + 1       : GOTO 3300    'right
  335. 3290    GOTO 3210
  336. 3300    IF X% < 1 THEN X% = 80 : ELSE IF X% > 80 THEN X% = 1
  337. 3310    GOTO 3200
  338. 3320    IF Y% < 9 THEN Y% = 25 : ELSE IF Y% > 25 THEN Y% = 9
  339. 3330    GOTO 3200
  340. 3340 REM
  341. 3350 REM  use xrep to clear the top 8 lines
  342. 3360 REM
  343. 3370   A$ = " " : COUNT% = 8 * 80  : ATTRIBUTE% = NORMAL%
  344. 3380        LOCATE 1,1 : CALL XREP( FLAG% , A$ , COUNT% , ATTRIBUTE% )
  345. 3390   LOCATE 2,20 : PRINT "After clearing the requested portion of the screen"
  346. 3400   LOCATE 3,20 : PRINT "CLREOL and CLREOS will leave the cursor in its original"
  347. 3410   LOCATE 4,20 : PRINT "location."
  348. 3420   LOCATE 5,30 : PRINT "Press ESC to repeat the CLREOL/CLREOS demo."
  349. 3430   LOCATE 6,30 : PRINT "  Enter a carriage return to proceed to"
  350. 3440   LOCATE 7,30 : PRINT "  the next demonstration."
  351. 3450   X$ = INKEY$ : IF LEN(X$) = 0 THEN 3450
  352. 3460   IF X$ = CHR$(27) THEN 2980
  353. 3470   IF X$ = CHR$(13) THEN 3530 ELSE 3450
  354. 3480 REM
  355. 3490 REM
  356. 3500 REM
  357. 3510 REM  next demonstrate     ZPRINT, SCRLDN, SCRLUP  ---------------------
  358. 3520 REM
  359. 3530   CLS : LOCATE 2,1
  360. 3540   PRINT TAB(3);"ZPRINT will print a character string starting at the"
  361. 3550   PRINT TAB(9);"current location using the special color/attribute"
  362. 3560   PRINT TAB(9);"passed in."
  363. 3570   PRINT TAB(3);"This screen will also demonstrate SCRLUP/SCRLDN which"
  364. 3580   PRINT TAB(9);"allow any portion of the page to be scrolled up or"
  365. 3585   PRINT TAB(9);"down."
  366. 3590   PRINT
  367. 3600   INPUT "Type a carriage return to display a screen using subroutine ZPRINT",A$
  368. 3601   CLS
  369. 3602   GOSUB 5690  ' write instructions at bottom of screen
  370. 3603    A1$ = "1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1"
  371. 3604    A2$ = "2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2"
  372. 3605    A3$ = "3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3"
  373. 3606    A4$ = "4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4"
  374. 3607    A5$ = "5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5"
  375. 3608    A6$ = "6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6"
  376. 3609    A7$ = "7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7"
  377. 3610    A8$ = "8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8"
  378. 3611    A9$ = "9 9 9 9 9 9 9 9 9 9 9 9 9 9 9 9 9 9 9 9"
  379. 3612    AA$ = "A A A A A A A A A A A A A A A A A A A"
  380. 3613    AB$ = "B B B B B B B B B B B B B B B B B B"
  381. 3614    AC$ = "C C C C C C C C C C C C C C C C C"
  382. 3615    AD$ = "D D D D D D D D D D D D D D D D"
  383. 3616    AE$ = "E E E E E E E E E E E E E E E"
  384. 3619 REM
  385. 3620    GOSUB 5030   'clear the screen
  386. 3630    GOSUB 5390   'generate page1 on top half of screen
  387. 3650    GOTO  4000
  388. 3660 REM
  389. 3670    GOSUB 5030   'clear the screen
  390. 3680    GOSUB 5090   'generate page2 on bottom half of screen
  391. 3700    GOTO  4000
  392. 3710 REM
  393. 4000    X$ = INKEY$ : IF LEN(X$) = 0 THEN 4000
  394. 4005    IF LEN(X$) = 1 THEN IF X$ = CHR$(13) THEN 6000 : ELSE 4000
  395. 4010    X$ = RIGHT$(X$,1)
  396. 4020    IF X$ = CHR$(59) THEN             GOTO 3620    'F1 page 1
  397. 4030    IF X$ = CHR$(60) THEN             GOTO 3670    'F2 page 2
  398. 4040    IF X$ = CHR$(72) THEN  GOSUB 5830  : GOTO 4000    'scroll up
  399. 4050    IF X$ = CHR$(80) THEN  GOSUB 5890  : GOTO 4000    'scroll down
  400. 4060    GOTO 4000
  401. 4997 REM
  402. 4998 REM --start of subroutines used for ZPRINT demo-----
  403. 4999 REM
  404. 5000    REM
  405. 5010    REM  clear the top 19 lines using SCRLDN
  406. 5020    REM
  407. 5030     X1% = 1 : Y1% = 1 : X2% = 80 : Y2% = 19 : COUNT% = 0
  408. 5040         CALL SCRLDN( Y1% , X1% , Y2% , X2% , COUNT%)
  409. 5050      RETURN
  410. 5060    REM
  411. 5070    REM  generate page2 in the bottom half of the screen
  412. 5080    REM
  413. 5090    PAGE% = 2
  414. 5095    A$ = "/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\"
  415. 5100      LOCATE 11,10 : CALL ZPRINT ( FLAG% , A$ , BLUE% )
  416. 5110    A$ = CHR$(179) : COUNT% = 7
  417. 5120      LOCATE 12,9  : CALL YREP ( FLAG% , A$ , COUNT% , BLUE% )
  418. 5130    A$ = CHR$(192) : COUNT% = 1
  419. 5140      LOCATE 19,9  : CALL XREP ( FLAG% , A$ , COUNT% , BLUE% )
  420. 5150    A$ = CHR$(196) : COUNT% = 60
  421. 5160             CALL XREP ( FLAG% , A$ , COUNT% , BLUE% )
  422. 5170    A$ = CHR$(217) : COUNT% = 1
  423. 5180             CALL XREP ( FLAG% , A$ , COUNT% , BLUE% )
  424. 5190    A$ = CHR$(179) : COUNT% = 7
  425. 5200      LOCATE 12,70 : CALL YREP ( FLAG% , A$ , COUNT% , BLUE% )
  426. 5220      LOCATE 12,18 : CALL ZPRINT ( FLAG% , A7$ , YELLOW% )
  427. 5240      LOCATE 13,17 : CALL ZPRINT ( FLAG% , A6$ , YELLOW% )
  428. 5260      LOCATE 14,16 : CALL ZPRINT ( FLAG% , A5$ , YELLOW% )
  429. 5280      LOCATE 15,15 : CALL ZPRINT ( FLAG% , A4$ , YELLOW% )
  430. 5300      LOCATE 16,14 : CALL ZPRINT ( FLAG% , A3$ , YELLOW% )
  431. 5320      LOCATE 17,13 : CALL ZPRINT ( FLAG% , A2$ , YELLOW% )
  432. 5340      LOCATE 18,12 : CALL ZPRINT ( FLAG% , A1$ , YELLOW% )
  433. 5350     RETURN
  434. 5360   REM
  435. 5370   REM  generate page1 in the top half of the screen
  436. 5380   REM
  437. 5390    PAGE% = 1
  438. 5395    A$ = "\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/"
  439. 5400      LOCATE 10,10 : CALL ZPRINT ( FLAG% , A$ , RED% )
  440. 5410    A$ = CHR$(179) : COUNT% = 7
  441. 5420      LOCATE  3,9  : CALL YREP ( FLAG% , A$ , COUNT% , RED% )
  442. 5430    A$ = CHR$(218) : COUNT% = 1
  443. 5440      LOCATE  2,9  : CALL XREP ( FLAG% , A$ , COUNT% , RED% )
  444. 5450    A$ = CHR$(196) : COUNT% = 60
  445. 5460             CALL XREP ( FLAG% , A$ , COUNT% , RED% )
  446. 5470    A$ = CHR$(191) : COUNT% = 1
  447. 5480             CALL XREP ( FLAG% , A$ , COUNT% , RED% )
  448. 5490    A$ = CHR$(179) : COUNT% = 7
  449. 5500      LOCATE  3,70 : CALL YREP ( FLAG% , A$ , COUNT% , RED% )
  450. 5520      LOCATE  3,26 : CALL ZPRINT ( FLAG% , AE$ , YELLOW% )
  451. 5540      LOCATE  4,25 : CALL ZPRINT ( FLAG% , AD$ , YELLOW% )
  452. 5560      LOCATE  5,24 : CALL ZPRINT ( FLAG% , AC$ , YELLOW% )
  453. 5580      LOCATE  6,23 : CALL ZPRINT ( FLAG% , AB$ , YELLOW% )
  454. 5600      LOCATE  7,22 : CALL ZPRINT ( FLAG% , AA$ , YELLOW% )
  455. 5620      LOCATE  8,21 : CALL ZPRINT ( FLAG% , A9$ , YELLOW% )
  456. 5640      LOCATE  9,20 : CALL ZPRINT ( FLAG% , A8$ , YELLOW% )
  457. 5650     RETURN
  458. 5660 REM
  459. 5670 REM   print instructions at the bottom of the screen
  460. 5680 REM
  461. 5690    A$ = "Type F1 to display page 1"
  462. 5700      LOCATE  20,6 : CALL ZPRINT ( FLAG% , A$ , GREEN% )
  463. 5710    A$ = "Type F2 to display page 2"
  464. 5720      LOCATE  21,6 : CALL ZPRINT ( FLAG% , A$ , GREEN% )
  465. 5730    A$ = "Type "+CHR$(24)+" to scroll the page up"
  466. 5740      LOCATE  22,6 : CALL ZPRINT ( FLAG% , A$ , GREEN% )
  467. 5750    A$ = "Type "+CHR$(25)+" to scroll the page down"
  468. 5760      LOCATE  23,6 : CALL ZPRINT ( FLAG% , A$ , GREEN% )
  469. 5770    A$ = "Type a carriage return to leave this demonstration screen"
  470. 5780      LOCATE  24,6 : CALL ZPRINT ( FLAG% , A$ , GREEN% )
  471. 5790   RETURN
  472. 5800 REM
  473. 5810 REM  scroll page up a line
  474. 5820 REM
  475. 5830     IF PAGE% = 2 THEN X1% = 10 : Y1% = 12 : X2% = 69 : Y2% = 18                      ELSE X1% = 10 : Y1% = 3 : X2% = 69 : Y2% = 9
  476. 5840        COUNT% = 1 : CALL SCRLUP( Y1% , X1% , Y2% , X2% , COUNT%)
  477. 5850    RETURN
  478. 5860 REM
  479. 5870 REM  scroll page down a line
  480. 5880 REM
  481. 5890     IF PAGE% = 2 THEN X1% = 10 : Y1% = 12 : X2% = 69 : Y2% = 18                      ELSE X1% = 10 : Y1% = 3 : X2% = 69 : Y2% = 9
  482. 5900        COUNT% = 1 : CALL SCRLDN( Y1% , X1% , Y2% , X2% , COUNT%)
  483. 5910    RETURN
  484. 5997 REM
  485. 5998 REM ----end of subroutines used for ZPRINT demo-----
  486. 5999 REM
  487. 6000 REM
  488. 6010   CLS : LOCATE 2,1
  489. 6020   PRINT TAB(3);"This concludes the ASMBASIC demonstration program."
  490. 6025   PRINT
  491. 6030   PRINT TAB(9);"The program is stored on diskette in file SUBDEMO.BAS"
  492. 6040   PRINT TAB(9);"as a printable text file.  Some versions will however"
  493. 6050   PRINT TAB(9);"contain tab characters.  Refer to files DETAB.BAS and"
  494. 6060   PRINT TAB(9);"SETABS.EPS for help in eliminating the embedded tabs."
  495. 6063 REM
  496. 6064   IF FLAG% = 3 THEN SYSTEM 'nothing more to do for business basic
  497. 6065 REM
  498. 6066   PRINT
  499. 6070   IF FLAG% > 0 THEN GOTO 6200
  500. 6080   PRINT "You may use this program to demonstrate the BASPRINT module."
  501. 6090   PRINT "Execute BASPRINT.EXE, then use the BASIC interpreter to rerun"
  502. 6100   PRINT "BASDEMO.BAS .  Those portions of the demonstration screens"
  503. 6110   PRINT "generated by PRINT statements will then execute several times"
  504. 6120   PRINT "faster."
  505. 6130    SYSTEM
  506. 6140 REM
  507. 6200   IF FLAG% = 1 THEN GOTO 6240 ' already compiled without /O
  508. 6202   PRINT "You may use this program to demonstrate the PRSLASHO module."
  509. 6210   PRINT "Execute PRSLASHO.EXE, then rerun this compiled BASIC program."
  510. 6220   PRINT "Those portions of the demonstration screens generated by"
  511. 6230   PRINT "PRINT statements will then execute several times faster."
  512. 6240   PRINT
  513. 6250   PRINT "If you use the BASIC runtime module BASRUN.EXE, you "
  514. 6260   PRINT "can compile and link SUBDEMO.BAS without the /O option."
  515. 6270   PRINT "Then execute COMPRINT.EXE to speed up those portions of"
  516. 6280   PRINT "the demonstration screens generated by PRINT statements."
  517. 6340    SYSTEM
  518.